perm filename UTIL.SAI[PNT,HE]3 blob
sn#471156 filedate 1979-09-04 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00014 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 ENTRY
C00003 00003 ! callm: like call and calli
C00005 00004 ! formatting command: cvtab
C00007 00005 ! ttytype: type of the teletype
C00008 00006 ! esc_p,brk_n
C00009 00007 ! string comparison function
C00010 00008 ! dat_str
C00012 00009 ! ugetf, uget
C00014 00010 ! file manipulation
C00022 00011 ! monitor
C00024 00012 ! integer to 11 fp conversion
C00027 00013 ! date and time routines
C00028 00014 ! swap to E, then resume
C00033 ENDMK
C⊗;
ENTRY;
BEGIN "UTILITY routines"
DEFINE ! = "COMMENT",
α = "BEGIN",
∨ = "END",
FF = "'14",
CR = "'15",
CRLF = "('15&'12)",
TAB = "'11",
LF = "'12";
EXTERNAL PROCEDURE PRESWAP;
EXTERNAL PROCEDURE POSTSWAP;
EXTERNAL PROCEDURE ERROR(STRING S,S1(NULL));
! callm: like call and calli;
SIMPLE PROCEDURE CALLM(INTEGER OP,AC,ADDR);
BEGIN ! 1 2 3
012345678 9012 3 4567 890123456789012345
OP AC I X ADDR
'777 777 777777
This procedure acts like CALL or CALLI for UUO's that cannot be called
that way;
INTEGER CODE;
LABEL L;
CODE←(OP LSH 27)+(AC LSH 23) +ADDR;
MEMORY[LOCATION(L)]←CODE;
START_CODE;
L: 0 ; ! preceding code will put value here;
END;
END;
INTERNAL SIMPLE INTEGER PROCEDURE CALLUUO(STRING UUO;REFERENCE INTEGER ADDR);
BEGIN
INTEGER UUOCODE;
UUOCODE←CALL(CVSIX(UUO),"CALLIT");
IF UUOCODE=0 THEN PRINT("NO SUCH UUO: ",UUO)
ELSE RETURN(CODE(UUOCODE,ADDR));
END;
INTERNAL SIMPLE PROCEDURE REASSI(INTEGER JOB; STRING DEVICE);
BEGIN
! assumes that DEVICE is inited by this job, and we want to assign to job
JOB: if it is to be assigned to the current job, set JOB←CALL(0,"PJOB").
To deassign, assign to nonexistent job ;
INTEGER DEV;
DEV←CVSIX(DEVICE);
START_CODE;
MOVE 1,JOB;
MOVE 2,DEV;
CALLI 1,'21; COMMENT THE REASSI UUO ;
END;
END;
! formatting command: cvtab;
INTERNAL SIMPLE STRING PROCEDURE CVTAB(STRING OLD_STRING);
BEGIN COMMENT convert tabs into relevant number of spaces to fill out;
INTEGER POSITION,LF_BREAK,TAB_BREAK,BRCHAR,BRCHAR2,I;
STRING NEW_STRING,TMP_STRING,TMP_STRING2;
NEW_STRING←NULL;
SETBREAK(LF_BREAK←GETBREAK,LF,NULL,"INA");
SETBREAK(TAB_BREAK←GETBREAK,TAB,NULL,"INS");
TMP_STRING←SCAN(OLD_STRING,LF_BREAK,BRCHAR);
DO BEGIN
IF TMP_STRING=CR THEN TMP_STRING←" "&CR;
! put a space for blank lines ;
TMP_STRING2←SCAN(TMP_STRING,TAB_BREAK,BRCHAR2);
WHILE BRCHAR2=TAB
DO BEGIN
I←8-(LENGTH(TMP_STRING2) MOD 8);
TMP_STRING2←TMP_STRING2&" "[1 TO I]
&SCAN(TMP_STRING,TAB_BREAK,BRCHAR2);
END;
NEW_STRING←NEW_STRING&TMP_STRING2;
TMP_STRING←SCAN(OLD_STRING,LF_BREAK,BRCHAR);
END UNTIL LENGTH(TMP_STRING)=0 AND BRCHAR=0;
RELBREAK(LF_BREAK);RELBREAK(TAB_BREAK);
RETURN(NEW_STRING);
END;
! ttytype: type of the teletype;
INTERNAL STRING PROCEDURE TTYTYPE;
BEGIN
INTEGER I;
I←-1;
CALLM('051,'6,LOCATION(I));
IF I=-1 THEN RETURN("DET");
I←I LSH -18;
IF I LAND '20000 THEN RETURN("DD")
ELSE IF I LAND '40000 THEN RETURN("DM")
ELSE IF I LAND '400000 THEN RETURN("III")
ELSE IF I LAND '200000 THEN RETURN("CTY")
ELSE RETURN("NEITHER III,DM,DD OR CTY; line characteristics are "&cvos(I)&",,000000");
END;
! esc_p,brk_n;
INTERNAL PROCEDURE ESC_P;
BEGIN
define ttyset = "'047000400121";
quick_code
hrroi 1,['004000000120]; comment [004000,,"P"];
ttyset 1, ; ! this last stuff does an esc-P;
end;
END;
INTERNAL PROCEDURE BRK_N;
BEGIN
define ttyset = "'047000400121";
quick_code
hrroi 1,['004000000516]; comment [004000,,400+"N"];
ttyset 1, ; ! this last stuff does an BRK-N;
end;
END;
! string comparison function ;
! compares two strings s1,s2. If they are equal returns 0
otherwise if s1 is alphabetically before s2 then
returns -1 else returns 1 ;
INTERNAL SIMPLE INTEGER PROCEDURE COMPEQU(STRING S1,S2);
BEGIN
INTEGER I1,I2;
IF EQU(S1,S2) THEN RETURN(0);
DO I1←LOP(S1) UNTIL I1≠(I2←LOP(S2));
IF I1>I2 THEN RETURN(-1) ELSE RETURN(1);
END;
! dat_str;
PRELOAD_WITH "Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sept","Oct","Nov","Dec";
STRING ARRAY $MONTH[0:11];
INTERNAL STRING PROCEDURE DAT_STR;
BEGIN
INTEGER SDATE,SSEC; integer width,digits;
INTEGER YEAR,MONTH,DATE,HOUR,MINUTE,SECOND;
STRING DATE_STRING;
comment using ACCTIM UUO;
quick_code;
calli '13,'400101;
hlrzm '13,SDATE;
hrrzm '13,SSEC;
end;
DATE←SDATE MOD 31;
SDATE←SDATE DIV 31;
MONTH←SDATE MOD 12;
YEAR←(SDATE DIV 12) + 1964;
SECOND←SSEC MOD 60;
SSEC←SSEC DIV 60;
MINUTE←SSEC MOD 60;
HOUR←SSEC DIV 60;
GETFORMAT(WIDTH,DIGITS);
SETFORMAT(0,0);
DATE_STRING←CVS(HOUR)&":";
SETFORMAT(-2,0);
DATE_STRING←DATE_STRING&CVS(MINUTE)&" ";
SETFORMAT(0,0);
DATE_STRING←DATE_STRING&CVS(DATE+1)&" "&$MONTH[MONTH]&" "&CVS(YEAR);
SETFORMAT(WIDTH,DIGITS);
RETURN(DATE_STRING);
END;
! ugetf, uget;
INTERNAL INTEGER PROCEDURE UGETF(INTEGER CHAN);
BEGIN ! positions the pointer to the last record in the file ;
define UGETF = '073000;
INTEGER I,CHN; LABEL DOUGTF;
CHN←CHAN;
quick_code;
move '13,CHN;
lsh '13,5;
addi '13,UGETF;
hrlm '13,DOUGTF; ! PREPARE UGETF;
DOUGTF:
I ;
end;
RETURN(I);
END;
INTERNAL INTEGER PROCEDURE UGET(INTEGER CHAN);
BEGIN ! gets the record number of the current place in the file ;
define MTAPE = '072000;
LABEL ADR,ADR1,DOMTPE; INTEGER CHN;
INTEGER GMOD; GMOD←CVSIX("GODMOD");
CHN←CHAN;
quick_code;
move '13,GMOD;
movem '13,ADR;
setzm '13,adr1;
move '13,CHN;
lsh '13,5;
addi '13,MTAPE;
hrlm '13,DOMTPE;
jrst DOMTPE ;
ADR:
0 ; ! '475744555744; ! SIXBIT /GODMOD/;
ADR1: 0 ;
DOMTPE:
ADR ;
move '13,ADR1;
movem '13,CHN;
end;
RETURN(CHN);
END;
! file manipulation;
INTERNAL STRING PROCEDURE FILENAME(INTEGER CHAN);
BEGIN ! given the i/o channel chan, this procedure returns full form of the
file name ;
STRING S,S1;
EXTERNAL INTEGER JOBJDA;
INTEGER DDB_ADDR;
INTEGER SPBREAK,I;
CALL(0,"SLEEP");
DDB_ADDR←MEMORY[LOCATION(JOBJDA)+CHAN] LAND '777777 ;
DEFINE DEVFIL='11,DEVEXT='12,FILPPN='14;
S←CVXSTR(CALL(DDB_ADDR+DEVFIL,"PEEK"))&"."&
CVXSTR(CALL(DDB_ADDR+DEVEXT,"PEEK"))[1 FOR 3]&
"["&CVXSTR(CALL(DDB_ADDR+FILPPN,"PEEK"))[1 TO 3]&","&
CVXSTR(CALL(DDB_ADDR+FILPPN,"PEEK"))[4 TO 6]&"]";
SETBREAK(SPBREAK←GETBREAK,NULL," ","I");
S1←SCAN(S,SPBREAK,I);
RELBREAK(SPBREAK);
RETURN(S1);
END;
INTERNAL PROCEDURE UDATEFILE(INTEGER CHAN);
BEGIN ! writes out the current file and reopens it
again at the end of the last page ;
INTEGER FLAG; INTEGER I; STRING S;
I←UGET(CHAN); CLOSE(CHAN);
S←FILENAME(CHAN);
LOOKUP(CHAN,S,FLAG);
ENTER(CHAN,S,FLAG);
USETI(CHAN,I); S←NULL;
DO S←S&INPUT(CHAN,0) UNTIL GETSTS(CHAN) LAND '20000;
! read til end of file;
USETO(CHAN,I); OUT(CHAN,S);
END;
INTERNAL INTEGER PROCEDURE OREADFILE(STRING FILE;REFERENCE INTEGER EOF);
BEGIN
INTEGER CHAN,BRCHAR,FLAG;
OPEN(CHAN←GETCHAN,"DSK",0,10,0,1000,BRCHAR,EOF);
LOOKUP(CHAN,FILE,FLAG);
IF NOT FLAG THEN RETURN(CHAN); ! success ;
RELEASE(CHAN);
CASE FLAG LAND '777777 OF
BEGIN
[0] ERROR(FILE&" is nonexistent");
[1] ERROR(FILE&" has illegal PPN");
[2] ERROR(FILE&" protection violation");
[3] ERROR(FILE&" is busy");
ELSE ERROR(FILE&": unknown error in opening file")
END;
END;
INTERNAL STRING PROCEDURE READFILE(STRING FILE);
BEGIN
INTEGER CHAN,EOF,FFBREAK;
STRING MSSGE;
CHAN←OREADFILE(FILE,EOF);
SETBREAK(FFBREAK←GETBREAK,FF,NULL,"ISN");
MSSGE←NULL;
WHILE NOT EOF DO MSSGE←MSSGE&" "&INPUT(CHAN,FFBREAK);
RELEASE(CHAN);
RELBREAK(FFBREAK);
RETURN(MSSGE);
END;
INTERNAL PROCEDURE WRITEFILE(STRING FILE,MSSGE);
BEGIN ! this will destroy existing file ;
INTEGER CHAN,BRCHAR,EOF,FLAG;
OPEN(CHAN←GETCHAN,"DSK",0,0,19,1000,BRCHAR,EOF);
ENTER(CHAN,FILE,FLAG);
IF FLAG THEN
BEGIN
RELEASE(CHAN);
CASE FLAG LAND '777777 OF
BEGIN
[0] ERROR("NULL filename given");
[1] ERROR(FILE&": illegal PPN");
[2] ERROR(FILE&" protection violation");
[3] ERROR(FILE&" is currently busy");
['12] ERROR("DISK is full...groan...");
ELSE ERROR(FILE&": unknown file error, code ="&
CVOS(FLAG LAND '777777))
END;
END;
OUT(CHAN,MSSGE);
CLOSE(CHAN);
RELEASE(CHAN);
END;
PROCEDURE DELETEFILE(STRING FILE);
BEGIN
INTEGER CHAN,BRCHAR,EOF,FLAG;
OPEN(CHAN←GETCHAN,"DSK",0,0,19,1000,BRCHAR,EOF);
ENTER(CHAN,FILE,FLAG);
RENAME(CHAN,NULL,0,FLAG);
CLOSE(CHAN);
RELEASE(CHAN);
END;
INTERNAL INTEGER PROCEDURE OWRITEFILE(STRING FILE);
BEGIN
INTEGER CHAN,BRCHAR,EOF,FLAG;
OPEN(CHAN←GETCHAN,"DSK",0,0,19,1000,BRCHAR,EOF);
ENTER(CHAN,FILE,FLAG);
RETURN(CHAN);
END;
BOOLEAN PROCEDURE FILE_ABSENT(STRING FNAME);
BEGIN "check if FNAME exists"
INTEGER INPCH,BRCHR,EOF;
BOOLEAN E;
OPEN(INPCH←GETCHAN,"DSK",0,3,0,1000,BRCHR,EOF);
LOOKUP(INPCH,FNAME,EOF);
E←EOF LAND '777777000000;
RELEASE(INPCH);
RETURN(E);
END;
INTERNAL INTEGER PROCEDURE ORAFILE(STRING FILE,S(NULL);BOOLEAN ERROR_RETURN(TRUE));
BEGIN
INTEGER CHAN,BRCHAR,EOF,FLAG;
IF FILE_ABSENT(FILE) THEN
BEGIN
CHAN←OWRITEFILE(FILE);
CLOSE(CHAN);
RELEASE(CHAN);
IF S=FF THEN S←S[2 TO ∞]; ! if begins with formfeed then can lop it off;
END;
! writes out the string s into file FILE:
if the first character is a formfeed then start on a new page.;
OPEN(CHAN←GETCHAN,"DSK",0,19,19,1000,BRCHAR,EOF);
LOOKUP(CHAN,FILE,FLAG);
ENTER(CHAN,FILE,FLAG);
IF FLAG THEN
BEGIN STRING S;
RELEASE(CHAN);
CASE FLAG LAND '777777 OF
BEGIN
[0] S←FILE&" is nonexistent";
[1] S←FILE&" illegal PPN";
[2] S←FILE&" protection violation";
[3] S←FILE&" is busy";
['12] S←"DISK is full.. groan..";
ELSE S←FILE&" error code = "&CVOS(FLAG LAND '777777)
END;
IF ERROR_RETURN THEN ERROR(S);
PRINT(S,CRLF);
RETURN(-1);
END;
IF S=FF THEN UGETF(CHAN)
ELSE BEGIN
INTEGER I; STRING S1;
DO INPUT(CHAN,0) UNTIL EOF;
I←UGET(CHAN);
USETI(CHAN,I);
S1←NULL;
DO S1←S1&INPUT(CHAN,0) UNTIL EOF;
USETO(CHAN,I);
OUT(CHAN,S1);
END;
OUT(CHAN,S);
RETURN(CHAN);
END;
INTERNAL PROCEDURE CRAFILE(INTEGER CHAN);
BEGIN
CLOSE(CHAN);
RELEASE(CHAN);
END;
INTERNAL PROCEDURE ADDFILE(STRING FILE,S);
BEGIN ! adds string S to a file FILE, which if does not exist is created
and then updates the file;
INTEGER CHAN;
CHAN←ORAFILE(FILE,S);
CRAFILE(CHAN);
END;
! monitor;
INTERNAL SIMPLE INTEGER PROCEDURE LOGIN(STRING PPN(NULL));
BEGIN
STRING S;
external integer _skip_;
INTEGER PTYLINE;
DO ptyline←ptyget UNTIL _skip_;
IF PPN≠NULL THEN S←PPN ELSE
BEGIN
STRING S1,S2;
S1←CVXSTR(CALL(0,"DSKPPN"))[1 TO 3];
S2←CVXSTR(CALL(0,"DSKPPN"))[4 TO 6];
WHILE S1=" " DO S1←S1[2 TO ∞];
WHILE S2=" " DO S2←S2[2 TO ∞];
S←S1&"."&S2;
END;
ptostr(PTYLINE,"L "&S&CRLF);
S←PTYSTR(PTYLINE,"↑");
S←PTYSTR(PTYLINE,".");
RETURN(PTYLINE);
END;
PROCEDURE MONCOM(INTEGER PTYLINE; STRING COMMAND);
BEGIN
STRING S;
PTOSTR(PTYLINE,COMMAND&CRLF);
S←PTYSTR(PTYLINE,"↑");
S←PTYSTR(PTYLINE,".");
END;
INTERNAL PROCEDURE LOGOUT(INTEGER PTYLINE);
PTYREL(PTYLINE);
INTERNAL PROCEDURE MONITOR(STRING COMMAND,PPN(NULL));
BEGIN
INTEGER PTY;
PTY←LOGIN(PPN);
MONCOM(PTY,COMMAND);
LOGOUT(PTY);
END;
! integer to 11 fp conversion ;
! PROCEDURE FOR CONVERTING A FLOATING POINT NUMBER IN 11 FORMAT ;
! plagiarized from BES in move.sai;
INTERNAL PROCEDURE FLTOUT(REAL FNUM; REFERENCE INTEGER XNUM1,XNUM2);
BEGIN
LABEL ST1,ST2,OVER,FLTEND;
INTEGER BYTE,NUM1,NUM2;
BYTE←'013200000002;
START_CODE
MOVE 2,FNUM;
JUMPGE 2,ST1;
MOVN 2,2;
TLO 2,'400000;
ST1: JFCL 2,ST2;
ST2: ADDI 2,4;
JFCL 2,OVER;
DPB 2,BYTE;
SETZ 1,;
LSHC 1,16;
MOVEM 1,NUM1;
SETZ 1,;
LSHC 1,16;
MOVEM 1,NUM2;
END;
XNUM1←NUM1;
XNUM2←NUM2;
GOTO FLTEND;
OVER: OUTSTR("ERROR-ROUNDING OVERFLOW"&CRLF);
FLTEND: END;
INTERNAL REAL PROCEDURE RFVAL(INTEGER WORD1,WORD2);
BEGIN
! This procedure gives the real floating point value of a floating point number
in WORD1 and WORD2 with F format of pdp-11.;
REAL X;
INTEGER SIGN,EXPONENT,FRACTION;
! PRINT(CRLF,"WORD1=",CVOS(WORD1)," WORD2=",CVOS(WORD2));
SIGN← WORD1 LSH -15;
EXPONENT← (WORD1 LSH 21) LSH -28 ;
FRACTION← (((WORD1 LAND '177) LOR (IF EXPONENT THEN '200 ELSE 0)) LSH 16) LOR WORD2 ;
IF SIGN=1 THEN BEGIN EXPONENT← LNOT EXPONENT; FRACTION← '100000000 - FRACTION; END;
! PRINT(CRLF,"SIGN=",SIGN," EXPONENT=",CVOS(EXPONENT)," FRACTION=",CVOS(FRACTION));
MEMORY[LOCATION(X),INTEGER]← SIGN LSH 35 LOR EXPONENT LSH 27 LOR FRACTION LSH 3 ;
! PRINT(CRLF,CVOS(X));
RETURN(X);
END;
! date and time routines;
! total runtime since login in msecs;
INTERNAL SIMPLE INTEGER PROCEDURE RUNTIM;
RETURN(CALL(0,"RUNTIM"));
! number of days since Jan 1, 1964;
INTERNAL SIMPLE INTEGER PROCEDURE DAYCNT;
RETURN(CALL(0,"DAYCNT"));
! number of msecs after midnight;
INTERNAL SIMPLE INTEGER PROCEDURE MSTIME;
RETURN(CALL(0,"MSTIME"));
! swap to E, then resume ;
INTERNAL PROCEDURE SWAP(REFERENCE STRING MODIFY_STRING);
BEGIN
! this procedure will save the current state of the POINTY program in
the file PONTY2.DMP[PNT,HE], and swap to E to a file called E$TEMP.TMP[PNT,HE]
which it writes with the contents of MODIFY_STRING,
and allows the user to modify. When the user exits E
by doing <control>XRUN, the POINTY program resumes by swapping back
PONTY2.DMP[PNT,HE] and renaming it POINTY, and then reading in E$TEMP.TMP[PNT,HE]
as the input string MODIFY_STRING;
EXTERNAL INTEGER JOBSA;
INTEGER ARRAY ACS[0:15]; ! temporary storage for accumulators;
INTEGER ARRAY EARRAY[0:'17];
INTEGER EA0,EA15;
INTEGER AACS0,AACS15,AACS14; ! address of ACS[0],ACS[15],ACS[14];
LABEL RESUME;
INTEGER ARRAY SAVADR[0:4],GETADR[0:5];
STRING COREIMAGEFILE,E$TEMP;
E$TEMP←"E$TEMP.TMP[PNT,HE]";
WRITEFILE(E$TEMP,MODIFY_STRING);
COREIMAGEFILE←"XXXXXX.DMP";
AACS0←LOCATION(ACS[0]);
AACS15←LOCATION(ACS[15]);
AACS14←LOCATION(ACS[14]);
SAVADR[0]←CVSIX("DSK");
SAVADR[1]←CVFIL(COREIMAGEFILE,SAVADR[2],SAVADR[4]);
! SAVADR[2]←SAVADR[2] LOR 1 used for saving high seg ;
! SAVADR[3]←LOCATION(RESUME);
GETADR[0]←CVSIX("SYS");
GETADR[1]←CVFIL("E.DMP[1,3]",GETADR[2],GETADR[4]); ! ? ;
! GETADR[2]←GETADR[2] LOR 4;
GETADR[3]←1;
GETADR[5]←CALL(0,"DSKPPN"); ! use current dsk ppn;
ARRCLR(EARRAY);
EARRAY[0]←CVFIL(COREIMAGEFILE,EARRAY[1],EARRAY[3]);
EARRAY[6]←CVSIX("DSK");
EARRAY['14]←CVFIL(E$TEMP,EARRAY['13],EARRAY['11]);
EARRAY['12]←CVSIX("DSK");
EARRAY['13]←EARRAY['13] LOR '100000; ! /N mode ;
EARRAY['15]←1; ! line no = 1;
EARRAY['16]←1; ! page no = 1;
EARRAY['17]←(LOCATION(SAVADR[0]) LSH 18) LOR LOCATION(GETADR[0]);
EA0←LOCATION(EARRAY[0]);
BRK_N;
PRINT("I am swapping to the Editor; when you are done with the Editor, type
<control>XRUN to resume. If you get out of E by typing <control>E, get
back into E by typing CONT and resume by typing <control>XRUN.
If you lose your core image, you can resume by doing a RU "&COREIMAGEFILE&"
");
PRESWAP;
quick_code
MOVEM 15,@AACS15; COMMENT SAVE ACCUMS ;
MOVE 15,AACS0;
BLT 15,@AACS14;
MOVEI 1,RESUME;
MOVEM 1,JOBSA;
MOVS 15,EA0; ! get address of state of E call ;
BLT 15,15; ! set up accumulator calls for E;
CALLI 15,'400004; ! swap to E ;
RESUME: JFCL ; ! no-op;
JFCL ; ! restore accumulators;
MOVS 15,AACS0; ! get address of AC[0];
BLT 15,15; ! BLT into memory;
end;
POSTSWAP;
CALL(CVSIX("POINTY"),"SETNAM");
DELETEFILE(COREIMAGEFILE);
MODIFY_STRING←READFILE(E$TEMP);
DELETEFILE(E$TEMP);
END;
END "UTILITY routines";